perm filename FILLER.F4[CMS,LCS]1 blob
sn#098723 filedate 1974-04-20 generic text, type T, neo UTF8
00100 C Q AND R ARE X,Y COORDS. NE(1)=WDCNT. OTHER NE'S HAVE 3
00200 C FOR INVIS. VECTORS. M=VERTICAL SCAN LINES
00300 SUBROUTINE FILLER(Q,R,NE,M)
00400 DIMENSION Q(1),R(1),NE(1)
00500 KK=NE(1)
00600 KJ=2
00700 DO 4 K=2,KK
00800 IF(NE(K).NE.3)GO TO 11
00900 NE(K)=KJ
01000 KJ=K+1
01100 GO TO 4
01200 11 NE(K)=0
01300 4 CONTINUE
01400 DO 12 K=1,KK
01500 Q(K)=IFIX(Q(K))
01600 12 R(K)=IFIX(R(K))
01700 NE(KK+1)=KJ
01800 C FINDS JUMPS
01900 DO 2 J=2,KK
02000 IF(NE(J).GT.0.OR.Q(J).EQ.Q(J-1))GO TO 2
02100 C SKIPS VERTICAL LINES
02200 X=HALF(Q,J)+.00001
02300 C MIDPOINT OF LINE
02400 ALT=HALF(R,J)
02500 C THE ALTITUDE
02600 KJ=0
02700
02800 100 DO 3 L=2,KK
02900 IF(L.EQ.J.OR.NE(L).GT.0)GO TO 3
03000 C NEXT FINDS LINE OVERLAP
03100 IF(MISS(L,X,Q,R))GO TO 3
03200 C NEXT FINDS ALT. OF CROSSING
03300 40 Y=HGHT(L,X,Q,R)
03400 IF(Y.LT.ALT)KJ=KJ+1
03500 3 CONTINUE
03600 IF(MOD(KJ,2).EQ.0)GO TO 2
03700 C NEXT IF FOUND A LINE TO DRAW LINES DOWN FROM.
03800 NE(J)=-1
03900 JA=3
04000 KJ=M
04100 ALT=.0001
04200 N=Q(J)
04300 L=Q(J-1)
04400 IF(N.LT.L)GO TO 33
04500 KJ=-KJ
04600 ALT=-ALT
04700 33 X=-1
04800 17 DO 6 K=N,L,KJ
04900 RK=K
05000 XK=RK
05100 IF(K.EQ.L)ALT=-ALT
05200 C NO SHIFT AT LAST POSITION
05300 RK=RK+ALT
05400 Y=HGHT(J,RK,Q,R)
05500 IF(X)CALL LINES(XK,Y,JA,M)
05600 JA=2
05700 H=-10000
05800
05900 18 DO 7 I=2,KK
06000 IF(NE(I).NE.0)GO TO 7
06100 C SKIP IF SAME LINE.
06200 IF(MISS(I,RK,Q,R))GO TO 7
06300 C TRY NEXT POINT IF IT HIT A -1 LINE.
06400 9 B=HGHT(I,RK,Q,R)
06500 IF(B.GT.Y)GO TO 7
06600 IF(B.LE.H)GO TO 7
06700 H=B
06800 C FOUND HIGHEST NEW POINT
06900 7 CONTINUE
07000 IF(H.EQ.Y)GO TO 31
07100 C WIPES OUT THIS LINE SEG.
07200 IF(H.NE.-10000)GO TO 31
07300 X=1
07400 GO TO 6
07500 31 CALL LINES(XK,H,2,M)
07600 IF(X.GT.0)CALL LINES(XK,Y,JA,M)
07700 X=-X
07800 6 CONTINUE
07900 2 CONTINUE
08000 IF(M.LT.6)CALL PLOT(0,0,3)
08100 RETURN
08200 END
08300
08400 FUNCTION HGHT(J,A,Q,R)
08500 DIMENSION Q(1),R(1)
08600 B=R(J-1)
08700 D=Q(J-1)
08800 F=Q(J)
08900 HGHT=((R(J)-B)*(A-D))/(F-D)+B
09000 IF(F.EQ.D)HGHT=B
09100 RETURN
09200 END
09300
09400 FUNCTION MISS(J,A,Q,R)
09500 DIMENSION Q(1),R(1)
09600 B=Q(J)
09700 C=Q(J-1)
09800 MISS=-1
09900 IF((A.LT.C.AND.A.GT.B).OR.(A.LT.B.AND.A.GT.C))MISS=0
10000 RETURN
10100 END
10200 C MISS=-1, HIT=0, POINT=1
10300
10400 FUNCTION HALF(A,J)
10500 DIMENSION A(1)
10600 HALF=(A(J-1)-A(J))/2.+A(J)
10700 RETURN
10800 END
10900
11000 SUBROUTINE LINES(A,B,J,I)
11100 M=A
11200 N=B
11300 IF(IABS(I).LT.6)GO TO 2
11400 IF(J.EQ.3)GO TO 1
11500 CALL AVECT(M,N)
11600 RETURN
11700 1 CALL AIVECT(M,N)
11800 RETURN
11900 2 CALL PLOT(M,N,J)
12000 RETURN
12100 END